perm filename PINIT1.2[EAL,HE] blob
sn#676510 filedate 1982-09-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {$NOMAIN Parser: part of the Initialization routine }
C00025 00003 { Externally defined routines from elsewhere: }
C00026 00004 (* routine to make reserved words: initReswords *)
C00028 00005 (* Aux routines (not external) used by initResWords *)
C00040 00006 (* initResWords: main part *)
C00043 ENDMK
C⊗;
{$NOMAIN Parser: part of the Initialization routine }
const
(* Constants from EDIT; need these for the constants section *)
maxLines = 28; (* smaller on the 11 than on the 10 *)
maxPPLines = 18;
maxBpts = 25;
maxTBpts = 20; (* max could be exceeded by huge case stmnt *)
listinglength = 2000; (* Length of Listingarray *)
(* Random type declarations for OMSI/SAIL compatibility *)
type
byte = 0..255; (* doesn't really belong here, but... *)
ascii = char;
atext = text;
{ Define all the pointer types here }
strngp = ↑strng;
statementp = ↑statement;
varidefp = ↑varidef;
nodep = ↑node;
identp = ↑ident;
reswordp = ↑resword;
(* This one is used whenever a pointer is needed for which the definition
is missing from this file; naturally, all pointers use the same space *)
dump = ↑integer;
token = array[1..4] of integer;
cursorp = array[1..4] of integer;
(* datatype definitions *)
datatypes = (pconstype, varitype, svaltype, vectype, rottype, transtype,
frametype, eventtype, strngtype, labeltype, proctype, arraytype,
reftype, valtype, cmontype, nulltype, undeftype,
dimensiontype, mactype, macargtype, freevartype);
scalar = real;
cstring = packed array [1..10] of ascii;
c4str = packed array [1..4] of ascii;
c5str = packed array [1..5] of ascii;
c20str = packed array [1..20] of ascii;
linestr = packed array [1..130] of ascii;
strng = record
next: strngp;
ch: cstring;
end;
(* statement definitions *)
stmntypes = (progtype, blocktype, coblocktype, endtype, coendtype,
fortype, iftype, whiletype, untiltype, casetype,
calltype, returntype,
printtype, prompttype, pausetype, aborttype, assigntype,
signaltype, waittype, enabletype, disabletype, cmtype,
affixtype, unfixtype,
movetype, operatetype, opentype, closetype, centertype,
stoptype, retrytype,
requiretype, definetype, macrotype, commenttype, dimdeftype,
setbasetype, wristtype, tovaltype, declaretype, emptytype);
(* more??? *)
statement = packed record
next, last: statementp; (* ↑ to lexical tokens? *)
stlab: varidefp;
exprs: nodep; (* any expressions used by this statement *)
nlines: integer;
bpt: boolean;
case stype: stmntypes of
progtype: (pcode: statementp; errors: integer);
blocktype,
declaretype,
endtype,
coendtype: (bcode, bparent: statementp; blkid: identp;
level, numvars: 0..255; variables: varidefp);
coblocktype: (threads: nodep; nthreads: integer; cblkid: identp);
fortype: (forvar, initial, step, final: nodep; fbody: statementp);
whiletype,
untiltype: (cond: nodep; body: statementp);
casetype: (index: nodep; range, ncases: integer; caselist: nodep);
iftype: (icond: nodep; thn, els: statementp);
pausetype: (ptime: nodep);
prompttype,
printtype,
aborttype: (plist: nodep; debugLev: integer);
returntype: (retval, rproc: nodep);
calltype,
assigntype: (what, aval: nodep);
affixtype,
unfixtype: (frame1, frame2, byvar, atexp: nodep; rigid: boolean);
signaltype,
waittype: (event: nodep);
movetype,
operatetype,
opentype,
closetype,
centertype,
stoptype: (cf, clauses: nodep);
retrytype: (rcode, rparent: statementp; olevel: integer);
cmtype: (oncond: nodep; conclusion: statementp;
deferCm, exprCm: boolean; cdef: varidefp);
enabletype,
disabletype: (cmonlab: varidefp);
requiretype: (rfil: boolean; rfils: strngp; rfilen: integer);
definetype: (macname,mpars: varidefp; macdef: dump);
commenttype: (len: integer; str: strngp; cbody: statementp);
dimdeftype: (dimname: varidefp; dimexpr: nodep);
setbasetype,
wristtype: (fvec, tvec: nodep);
tovaltype: (vstr: strngp; vlen: integer; waitp: boolean);
end;
(* auxiliary definitions: variable, etc. *)
varidef = packed record
next,dnext: varidefp;
name: identp;
level: 0..255; (* environment level *)
offset: 0..255; (* environment offset *)
dtype: varidefp; (* to hold the dimension info *)
tbits: 0..15; (* special type bits: array = 1, proc = 2, ref = 4 & ? *)
dbits: 0..15; (* for use by debugger/interpreter *)
case vtype: datatypes of
arraytype: (a: nodep);
proctype: (p: nodep);
labeltype,
cmontype: (s: statementp);
mactype: (mdef: statementp);
macargtype: (marg: dump);
pconstype: (c: nodep);
dimensiontype: (dim: nodep);
end;
(* definition of the ubiquitous NODE record *)
nodetypes = (exprnode, leafnode, listnode, clistnode, colistnode, forvalnode,
deprnode, viaptnode, apprnode, destnode, durnode,
sfacnode, wobblenode, swtnode, nullingnode, wristnode, cwnode,
arrivalnode, departingnode,
ffnode, forcenode, stiffnode, gathernode, cmonnode, errornode,
calcnode, arraydefnode, bnddefnode, bndvalnode,
waitlistnode, procdefnode, tlistnode, dimnode, commentnode);
exprtypes = ( svalop, (* scalar operators *)
sltop, sleop, seqop, sgeop, sgtop, sneop, (* relations *)
notop, orop, xorop, andop, eqvop, (* logical *)
saddop, ssubop, smulop, sdivop, snegop, sabsop, (* scalar ops *)
sexpop, maxop, minop, intop, idivop, modop,
sqrtop, logop, expop, timeop, (* functions *)
sinop, cosop, tanop, asinop, acosop, atan2op, (* trig *)
vdotop, vmagnop, tmagnop,
vecop, (* vector operators *)
vmakeop, unitvop, vaddop, vsubop, crossvop, vnegop,
svmulop, vsmulop, vsdivop, tvmulop, wrtop,
tposop, taxisop,
transop, (* trans operators *)
tmakeop, torientop, ttmulop, tvaddop, tvsubop, tinvrtop,
vsaxwrop, constrop, ftofop, deproachop, fmakeop, vmkfrcop,
ioop, (* i/o operators *)
queryop, inscalarop,
specop, (* special operators *)
arefop, callop, grinchop, macroop, vmop, adcop, dacop,
badop,
addop, subop, negop, mulop, divop, absop); (* for parsing *)
leaftypes = pconstype..strngtype;
reltypes = sltop..sgtop;
forcetypes = (force,absforce,torque,abstorque,angvelocity);
node = record
next: nodep;
case ntype: nodetypes of
leafnode: (case ltype: leaftypes of
varitype: (vari: varidefp; vid: identp);
pconstype: (cname: varidefp; pcval: nodep);
svaltype: (s: scalar; wid: integer);
vectype: (v: dump);
transtype: (t: dump);
strngtype: (length: integer; str: strngp) ); (* also used by commentnodes *)
dimnode: (time, distance, angle, dforce: integer);
end;
(* records for parser: ident, token, resword *)
ident = record
next: identp;
length: integer;
name: strngp;
predefined: varidefp;
end;
tokentypes = (reswdtype, identtype, constype, comnttype, delimtype, labeldeftype,
macpartype);
constypes = svaltype..strngtype;
reswdtypes = (stmnttype, filtype, clsetype, decltype, optype, edittype);
filtypes = (abouttype,alongtype,attype,bytype,defertype,dotype,elsetype,
errmodestype,fromtype,handtype,intype,nonrigidlytype,rigidlytype,
sourcefiletype,steptype,thentype,totype,untltype,viatype,
withtype,worldtype,zeroedtype,oftype,wheretype,nowaittype,
ontype,offtype,ppsizetype,collecttype,alltype,lextype);
clsetypes = (approachtype,arrivaltype,departuretype,departingtype,durationtype,
errortype,forcetype,forceframetype,forcewristtype,gathertype,
nildeproachtype,nonullingtype,nullingtype,stiffnesstype,
torquetype,velocitytype,wobbletype,
cwtype,ccwtype,stopwaittimetype,angularvelocitytype,
fxtype,fytype,fztype,mxtype,mytype,mztype,
t1type,t2type,t3type,t4type,t5type,t6type,tbltype);
edittypes = (getcmd,savecmd,insertcmd,renamecmd,startcmd,gocmd,proceedcmd,
stepcmd,sstepcmd,nstepcmd,gstepcmd,executecmd,setcmd,tracecmd,
breakcmd,unbreakcmd,tbreakcmd,definecmd,markcmd,unmarkcmd,
popcmd);
resword = record
next: reswordp;
length: integer;
name: strngp;
case rtype: reswdtypes of
stmnttype: (stmnt: stmntypes);
filtype: (filler: filtypes);
clsetype: (clause: clsetypes);
decltype: (decl: datatypes);
optype: (op: exprtypes);
edittype: (ed: edittypes);
end;
(* Global variables *)
var
(* From ALMAIN *)
b:boolean;
ch:ascii;
ltime: real;
(* From PARSE *)
reswords: array [0..26] of reswordp;
idents: array [0..26] of identp;
macrostack: array [1..10] of dump;
curmacstack: array [1..10] of varidefp;
macrodepth: integer;
curchar, maxchar, curline: integer;
curBlock,newDeclarations: statementp;
curProc: varidefp;
pnode: nodep;
nodim, distancedim, timedim, angledim,
forcedim, torquedim, veldim, angveldim: varidefp;
fvstiffdim, mvstiffdim: nodep;
filedepth: integer;
curpage: integer;
sysVars,unVars: varidefp;
errcount: integer;
outerBlock: statementp;
curVariable: varidefp;
curMotion: statementp;
endOk,coendOk: integer;
moveLevel: integer;
curErrhandler, curCmon: statementp;
endOfLine, backup, expandmacros, flushcomments, dimCheck: boolean;
semiseen, shownline: boolean;
eofError: boolean;
inMove,inCoblock: boolean;
curtoken: token;
file1,file2,file3,file4,file5: atext;
line: linestr;
(* From INTERP *)
(* curInt, activeInts, readQueue, allPdbs: pdbp;
curEnv, sysEnv: envheaderp;
clkQueue: nodep;
allEvents: dump;
STLevel: integer;
etime: integer;
curtime: integer;
stime: integer;
msg: messagep;
inputp: integer;
debugLevel: integer; *)
d1: array[1..15] of dump;
tSingleThreadMode: boolean;
resched, running, escapeI, singleThreadMode: boolean;
msgp: boolean; (* flag set if any messages pending *)
inputReady: boolean;
inputLine: array [1..20] of ascii;
(* From EDIT *)
lines: array [1..maxLines] of dump;
ppLines: array [1..maxPPLines] of dump;
marks: array [1..20] of integer;
cursorStack: array [1..15] of cursorp;
bpts: array [1..maxBpts] of statementp;
tbpts: array [1..maxTBpts] of statementp;
debugPdbs: array [0..10] of dump;
screenheight,dispHeight: integer;
ppBufp,oppBufp,ppOffset,ppSize,nmarks: integer;
lbufp,cursor,ocur,cursorLine,fieldnum,lineNum,findLine,pcLine: integer;
firstDline,topDline,botDline,firstLine,lastLine: integer;
freeLines,oldLines: dump;
findStmnt: statementp;
nbpts,ntbpts: integer;
eCurInt: dump;
dProg: statementp;
smartTerminal: boolean;
setUp,setExpr,setCursor,dontPrint,outFilep,newVarOk,collect: boolean;
eBackup: boolean;
eSingleThreadMode: boolean;
listing: packed array [0..listinglength] of ascii;
lbuf: array [1..160] of ascii;
ppBuf: array [1..100] of ascii;
outFile: atext;
eCurToken: token;
(* Various device & variable pointers *)
speedfactor: dump;
barm: dump;
(* Various constant pointers *)
xhat,yhat,zhat,nilvect: dump;
niltrans: dump;
bpark, ypark, gpark, rpark: dump; (* arm park positions *)
{ Externally defined routines from elsewhere: }
(* From ALLOC *)
function newStrng: strngp; external;
(* From PAUX1 *)
function hash(ch: ascii): integer; external;
(* routine to make reserved words: initReswords *)
{ This guy is NOT external }
function makeResword(t: reswdtypes; s: cstring): reswordp;
var res: reswordp; str: strngp; i: integer;
begin
new(res);
with res↑ do
begin
rtype := t;
str := newStrng;
str↑.ch := s;
name := str;
length := 10;
while s[length] = ' ' do length := length - 1;
end;
i := hash(s[1]); (* find proper bucket *)
res↑.next := reswords[i]; (* link us onto list of reserved words *)
reswords[i] := res;
makeResword := res;
end;
(* I had to cut up initResWords since the compiler couldn't deal with it *)
(* Aux routines (not external) used by initResWords *)
procedure makeallst;
procedure stmake(st: stmntypes; s: cstring);
var res: reswordp;
begin
res := makeResword(stmnttype,s);
res↑.stmnt := st;
end;
begin {makeallst}
stmake(progtype,'PROGRAM ');
stmake(blocktype,'BEGIN ');
stmake(coblocktype,'COBEGIN ');
stmake(coendtype,'COEND ');
stmake(endtype,'END ');
stmake(assigntype,':= ');
stmake(fortype,'FOR ');
stmake(iftype,'IF ');
stmake(whiletype,'WHILE ');
stmake(casetype,'CASE ');
stmake(returntype,'RETURN ');
stmake(printtype,'PRINT ');
stmake(prompttype,'PROMPT ');
stmake(pausetype,'PAUSE ');
stmake(aborttype,'ABORT ');
stmake(signaltype,'SIGNAL ');
stmake(waittype,'WAIT ');
stmake(enabletype,'ENABLE ');
stmake(disabletype,'DISABLE ');
stmake(cmtype,'ON ');
stmake(affixtype,'AFFIX ');
stmake(unfixtype,'UNFIX ');
stmake(movetype,'MOVE ');
stmake(operatetype,'OPERATE ');
stmake(opentype,'OPEN ');
stmake(closetype,'CLOSE ');
stmake(centertype,'CENTER ');
stmake(stoptype,'STOP ');
stmake(retrytype,'RETRY ');
stmake(requiretype,'REQUIRE ');
stmake(definetype,'DEFINE ');
stmake(dimdeftype,'DIMENSION ');
stmake(commenttype,'COMMENT ');
stmake(setbasetype,'SETBASE ');
stmake(wristtype,'WRIST ');
stmake(tovaltype,'VAL ');
end {makeallst};
procedure makeallfil (var Estr: strngp);
var res: reswordp;
procedure filmake(fil: filtypes; s: cstring);
var res: reswordp;
begin
res := makeResword(filtype,s);
res↑.filler := fil;
end;
begin
filmake(abouttype,'ABOUT ');
filmake(alongtype,'ALONG ');
filmake(attype,'AT ');
filmake(bytype,'BY ');
filmake(defertype,'DEFER ');
filmake(dotype,'DO ');
filmake(elsetype,'ELSE ');
res := makeResword(filtype,'ERROR_MODE');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'S ';
res↑.length := 11;
res↑.filler := errmodestype;
filmake(fromtype,'FROM ');
filmake(handtype,'HAND ');
filmake(intype,'IN ');
filmake(nonrigidlytype,'NONRIGIDLY');
filmake(rigidlytype,'RIGIDLY ');
res := makeResword(filtype,'SOURCE_FIL');
Estr := newStrng;
Estr↑.ch := 'E ';
res↑.name↑.next := Estr;
res↑.length := 11;
res↑.filler := sourcefiletype;
filmake(steptype,'STEP ');
filmake(thentype,'THEN ');
filmake(totype,'TO ');
filmake(untltype,'UNTIL ');
filmake(viatype,'VIA ');
filmake(withtype,'WITH ');
filmake(worldtype,'WORLD ');
filmake(zeroedtype,'ZEROED ');
filmake(oftype,'OF ');
filmake(wheretype,'WHERE ');
filmake(nowaittype,'NOWAIT ');
filmake(offtype,'OFF ');
filmake(ppsizetype,'BOTSIZE ');
filmake(collecttype,'COLLECT ');
filmake(alltype,'ALL ');
filmake(lextype,'LEX ');
end {makeallfil};
procedure makeallcl (Estr: strngp);
var res: reswordp;
procedure clmake(cl: clsetypes; s: cstring);
var res: reswordp;
begin
res := makeResword(clsetype,s);
res↑.clause := cl;
end;
begin
clmake(approachtype,'APPROACH ');
clmake(arrivaltype,'ARRIVAL ');
clmake(departuretype,'DEPARTURE ');
clmake(departingtype,'DEPARTING ');
clmake(durationtype,'DURATION ');
clmake(errortype,'ERROR ');
clmake(forcetype,'FORCE ');
res := makeResword(clsetype,'FORCE_FRAM');
res↑.name↑.next := Estr;
res↑.length := 11;
res↑.clause := forceframetype;
res := makeResword(clsetype,'FORCE_WRIS');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'T ';
res↑.length := 11;
res↑.clause := forcewristtype;
clmake(gathertype,'GATHER ');
clmake(fxtype,'FX ');
clmake(fytype,'FY ');
clmake(fztype,'FZ ');
clmake(mxtype,'MX ');
clmake(mytype,'MY ');
clmake(mztype,'MZ ');
clmake(t1type,'T1 ');
clmake(t2type,'T2 ');
clmake(t3type,'T3 ');
clmake(t4type,'T4 ');
clmake(t5type,'T5 ');
clmake(t6type,'T6 ');
clmake(tbltype,'TBL ');
res := makeResword(clsetype,'NILDEPROAC');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'H ';
res↑.length := 11;
res↑.clause := nildeproachtype;
clmake(nonullingtype,'NO_NULLING');
clmake(nullingtype,'NULLING ');
clmake(stiffnesstype,'STIFFNESS ');
clmake(torquetype,'TORQUE ');
clmake(velocitytype,'VELOCITY ');
clmake(wobbletype,'WOBBLE ');
clmake(cwtype,'CW ');
clmake(cwtype,'CLOCKWISE ');
clmake(ccwtype,'CCW ');
res := makeResword(clsetype,'COUNTER_CL');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'OCKWISE ';
res↑.length := 17;
res↑.clause := ccwtype;
res := makeResword(clsetype,'ANGULAR_VE');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'LOCITY ';
res↑.length := 16;
res↑.clause := angularvelocitytype;
res := makeResword(clsetype,'STOP_WAIT_');
res↑.name↑.next := newStrng;
res↑.name↑.next↑.ch := 'TIME ';
res↑.length := 14;
res↑.clause := stopwaittimetype;
end {makeallcl};
procedure makeallop;
procedure opmake(opr: exprtypes; s: cstring);
var res: reswordp;
begin
res := makeResword(optype,s);
res↑.op := opr;
end;
begin
opmake(sltop,'< ');
opmake(sleop,'<= ');
opmake(sleop,'=< ');
opmake(seqop,'= ');
opmake(sgeop,'>= ');
opmake(sgeop,'=> ');
opmake(sgtop,'> ');
opmake(sneop,'<> ');
opmake(notop,'NOT ');
opmake(orop,'OR ');
opmake(xorop,'XOR ');
opmake(andop,'AND ');
opmake(eqvop,'EQV ');
opmake(sexpop,'↑ ');
opmake(maxop,'MAX ');
opmake(minop,'MIN ');
opmake(intop,'INT ');
opmake(idivop,'DIV ');
opmake(modop,'MOD ');
opmake(sqrtop,'SQRT ');
opmake(logop,'LOG ');
opmake(expop,'EXP ');
opmake(timeop,'RUNTIME ');
opmake(sinop,'SIN ');
opmake(cosop,'COS ');
opmake(tanop,'TAN ');
opmake(asinop,'ASIN ');
opmake(acosop,'ACOS ');
opmake(atan2op,'ATAN2 ');
opmake(vdotop,'. ');
opmake(unitvop,'UNIT ');
opmake(vmakeop,'VECTOR ');
opmake(wrtop,'WRT ');
opmake(tposop,'POS ');
opmake(taxisop,'AXIS ');
opmake(tmakeop,'TRANS ');
opmake(fmakeop,'FRAME ');
opmake(torientop,'ORIENT ');
opmake(tinvrtop,'INV ');
opmake(vsaxwrop,'ROT ');
opmake(constrop,'CONSTRUCT ');
opmake(deproachop,'DEPROACH ');
opmake(ftofop,'-> ');
opmake(queryop,'QUERY ');
opmake(inscalarop,'INSCALAR ');
opmake(adcop,'ADC ');
opmake(dacop,'DAC ');
opmake(addop,'+ ');
opmake(subop,'- ');
opmake(mulop,'* ');
opmake(divop,'/ ');
opmake(absop,'| ');
opmake(grinchop,'# ');
end {makeallop};
(* initResWords: main part *)
procedure initReswords; external;
procedure initReswords;
var i: integer; res: reswordp; Estr: strngp;
procedure dcmake(dc: datatypes; s: cstring);
var res: reswordp;
begin
res := makeResword(decltype,s);
res↑.decl := dc;
end;
procedure editmake(ed: edittypes; s: cstring);
var res: reswordp;
begin
res := makeResword(edittype,s);
res↑.ed := ed;
end;
begin
for i := 0 to 26 do reswords[i] := nil;
makeallst; (* Make all the statements *)
makeallfil(Estr); (* and all the fillers *)
makeallcl(Estr); (* and all the clauses *)
makeallop; (* all the operators *)
dcmake(arraytype,'ARRAY ');
dcmake(eventtype,'EVENT ');
dcmake(labeltype,'LABEL ');
dcmake(proctype,'PROCEDURE ');
dcmake(reftype,'REFERENCE ');
dcmake(svaltype,'SCALAR ');
dcmake(valtype,'VALUE ');
editmake(getcmd,'GET '); (* for use by the editor/debugger *)
editmake(savecmd,'SAVE ');
editmake(insertcmd,'INSERT ');
editmake(renamecmd,'RENAME ');
editmake(startcmd,'START ');
editmake(startcmd,'RUN ');
editmake(gocmd,'GO ');
editmake(proceedcmd,'PROCEED ');
editmake(sstepcmd,'SSTEP ');
editmake(nstepcmd,'NSTEP ');
editmake(gstepcmd,'GSTEP ');
editmake(executecmd,'EXECUTE ');
editmake(setcmd,'SET ');
editmake(tracecmd,'TRACE ');
editmake(breakcmd,'BREAK ');
editmake(unbreakcmd,'UNBREAK ');
editmake(tbreakcmd,'TBREAK ');
editmake(markcmd,'MARK ');
editmake(unmarkcmd,'UNMARK ');
editmake(popcmd,'POP ');
end;